(in-package :timeclock)

(define-application-frame word		;name
    ()					;superclasses
  ()					;slots
  ;; options
  (:panes				;panes option
   (title				;pane name 
    :application)			;pane type
   (document				;pane name
    :application
    :display-function #'display-document))
  (:layouts				;layouts option
   (default				;layout name
       (vertically ()			;layout macros
	 (7/8 title)
	 (1/8 document)))))

(defmethod display-document ((frame word) stream)
  (formatting-table (stream)
    (let ((items '(a b c d e f g h i j k l m n o p q r s t u v w x y z)))
      (do () 
          ((null items)) 
        (formatting-row (stream)  
          (do ((i 0 (1+ i))) 
	      ((or (null items) (= i 6)))  
            (formatting-cell (stream) 
	      (format stream "~A" (pop items)))))))))



(run-frame-top-level (make-application-frame 'word :height 300 :width 300))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun press (button)
  (accepting-values (*query-io* :own-window t)
    (format *query-io* "~A" button)))

(defun squeeze (button)
  (accepting-values (*query-io* :own-window t)
    (format *query-io* "~A" button)))

(defun switch-layouts (button)
  (declare (ignore button))
  (let* ((layouts (frame-all-layouts *application-frame*))
	 (old-layout (frame-current-layout *application-frame*))
	 (new-layout (or (second (member old-layout layouts))
			 (car layouts))))
    (setf (frame-current-layout *application-frame*) new-layout)))

(define-application-frame buttons	;name
    ()					;superclasses
  ()					;slots
  ;; options
  (:panes (button 
	   (horizontally ()
	     (make-pane 'push-button :label "squeeze" :activate-callback #'squeeze)
	     (make-pane 'push-button :label "press" :activate-callback #'press)
	     (make-pane 'push-button :label "Change layout" :activate-callback #'switch-layouts))) 
	  (application			;pane name 
	   :application))		;pane type ... :application is an extended-stream-pane
  (:layouts (default			;layout name
	     (vertically ()		;layout macros
	       (1/8 button) (7/8 application)))
	    (alternate			;layout name
	     (horizontally ()		;layout macros
	       (1/8 button) (7/8 application)))))

(defparameter *application-frame* (make-application-frame 'buttons :height 300 :width 300))

(run-frame-top-level *application-frame*)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-application-frame word		;name
     ()					;superclasses
  ((doc-title				;slots
    :accessor doc-title
    :initarg :doc-title))

   ;; options

   (:panes
    (title				;pane name 
     :application			;pane type
     ;; pane options
     :display-function #'display-doc-title
     :initial-cursor-visibility nil)
    (document				;pane name 
     :application))			;pane type

   (:layouts
    (default				;name of the layout
	(vertically ()			;layout macros
	  (1/4 title)
	  (3/4 document)))))

(defmethod display-doc-title ((frame word) stream)
  (draw-text* stream "Document:" 10 15)
  (if (slot-boundp frame 'doc-title)
      (draw-text* stream (doc-title frame) 20 40)
      (draw-text* stream "Untitled" 20 40)))

(run-frame-top-level
 (make-application-frame 'word 
			 :height 300
			 :width 300
			 :doc-title "Microcrock's Business Plan"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-application-frame test ()
  ()
  (:panes
   (display :application
	    :display-function #'display-display))
  (:layouts
   (default display)))

(run-frame-top-level
 (make-application-frame 'test
			 :height 300
			 :width 300))

(defmethod display-display ((frame test) stream)
  (menu-choose '("Spam, eggs, sausage and spam"
		 "Spam, spam, spam, spam, and spam"
		 "h3rbal v1agr4!!!!1"
		 "Salisbury Steak")
	       :label "What'll it be?"
	       :associated-window (get-frame-pane frame 'display)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#+nil
(defun reset-clock (stream) 
  (multiple-value-bind (second minute hour day month) 
      (decode-universal-time 
       (get-universal-time))
  (declare (ignore second)) 
  (format stream "Enter the time~%") 
    (restart-case 
     (progn 
       (clim:accepting-values (stream) 
        (setq month 
              (clim:accept 'integer :stream stream 
                           :default month :prompt "Month")) 
        (terpri stream) 
        (setq day 
              (clim:accept 'integer :stream stream 
                           :default day :prompt "Day"))
        (terpri stream) 
        (setq hour 
              (clim:accept 'integer :stream stream 
                           :default hour :prompt "Hour")) 
        (terpri stream) 
        (setq minute 
              (clim:accept 'integer :stream stream 
                           :default minute :prompt "Minute")))
       ;; This could be code to reset the time, but instead 
       ;; we're just printing it out
       (format t "~%New values: Month: ~D, Day: ~D, Time: ~D:~2,'0D." 
               month day hour minute)) 
   (abort () (format t "~&Time not set")))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

